home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / WIN_VID / QTFLAT.ZIP;1 / QTFLAT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-05-29  |  8.2 KB  |  301 lines
  1. {$A-,B-,D+,E-,F+,G-,I-,L+,N-,O-,R-,S-,V-,X+}
  2. {$M 16384,0,0}
  3. const
  4.      HeaderSign:array[0..3] of char='mdat';
  5.      DescrSign:array[0..3] of char='moov';
  6.      QTType:array[0..3] of char='MooV';
  7. type
  8.    appleDword=longint;
  9.    appleWord=word;
  10.    tswitches=record
  11.         executor:boolean; {Executor created files?}
  12.          end;
  13.  
  14.    tmacheader=record
  15.         namelen:appleword;
  16.         name:array[0..62] of char;
  17.         filetype:array[0..3] of char; {MooV for QT movie}
  18.         creator:array[0..3] of char;
  19.         smth1:array[0..9] of byte;
  20.         fsize:appleDword;
  21.         smth2:array[0..40] of byte;
  22.           end;
  23.    tfilestruct=record
  24.         handle:word;
  25.         smth:array[0..45] of byte;
  26.         name:array[0..79] of char;
  27.            end;
  28.      qtheader=record
  29.         DescrOffset:appleDword;
  30.         Sign:array[0..3] of char; {mdat}
  31.           end;
  32.      qtDescr=record
  33.            StructSize:appleDword;
  34.            sign:array[0..3] of char;  {moov}
  35.          end;
  36. procedure quit(message:string);
  37. begin
  38.  writeln(message);
  39.  halt;
  40. end;
  41.  
  42. function copyfile(var fin,fout:file;size:longint):boolean;
  43. var p:pointer;                 {Copies SIZE bytes from FIN to FOUT}
  44.  len:longint;I:integer;      { using all free memory for buffer}
  45.  hbuf,hbuflen:word;
  46.  
  47. procedure readfile(var f:file;buf:pointer;asize:longint);
  48. var i:integer;a,nreads:word;
  49. begin
  50.  nreads:=asize div $8000;
  51.  for i:=1 to  nreads do
  52.         begin
  53.           blockread(f,buf^,$8000);
  54.           buf:=ptr(seg(buf^)+$800,0);
  55.         end;
  56.  blockread(f,buf^,asize mod $8000,a);
  57. end;
  58.  
  59. procedure writefile(var f:file;buf:pointer;asize:longint);
  60. var i:integer;a,nreads:word;
  61. begin
  62.  nreads:=asize div $8000;
  63.  for i:=1 to nreads do
  64.         begin
  65.           blockwrite(f,buf^,$8000);
  66.           buf:=ptr(seg(buf^)+$800,0);
  67.         end;
  68.  blockwrite(f,buf^,asize mod $8000,a);
  69. end;
  70.  
  71. begin
  72.  asm
  73.     mov ah,48h
  74.     mov bx,0ffffh
  75.     int 21h
  76.     mov hbuflen,bx
  77.     mov ah,48h
  78.     int 21h        {Allocate All memory for buffer}
  79.     mov hbuf,ax
  80.  end;
  81.  len:=longint(hbuflen) shl 4;
  82.  p:=ptr(hbuf,0);
  83.  for i:=1 to (size div len) do
  84.   begin
  85.    readfile(fin,p,len);
  86.    writefile(fout,p,len);
  87.   end;
  88.   readfile(fin,p,size mod len);
  89.   writefile(fout,p,size mod len);
  90.  asm
  91.     mov ah,49h
  92.     mov es,hbuf {Free memory}
  93.     int 21h
  94.  end;
  95. end;
  96.  
  97. function Ask(question:string):char;
  98. var c:char;
  99. begin
  100.  write(question);
  101.  repeat
  102.  asm
  103.     mov ah,0
  104.     int 16h   {Get character from keyboard}
  105.     mov c,al
  106.  end;
  107.   c:=upcase(c);
  108.  until (c='Y') or (c='N');
  109.  writeln(c);
  110.  ask:=c;
  111. end;
  112.  
  113. Function IBMDD(AppleDD:appleDword):longint;assembler;
  114. asm
  115.     les dx,appleDD     {Convert Apple DD to IBM DD}
  116.     mov ax,es
  117.     xchg al,ah
  118.     xchg dl,dh
  119. end;
  120. Function AppleDD(DD:longint):appleDword;
  121. begin
  122.  appleDD:=IbmDD(dd);    {Convert IBM DD to Aplle DD}
  123. end;
  124.  
  125. function skipmacheader(var f:file):boolean;
  126. var res:boolean;
  127.     h:tmacheader;
  128. begin
  129.  res:=true;
  130.  blockread(f,h,sizeof(h));
  131.  if h.filetype<>QTType then begin seek(f,filepos(f)-128); res:=false; end;
  132. skipmacheader:=res;
  133. end;
  134.  
  135.  
  136. var l:longint;
  137.     fdat,fres,fout:file;
  138.     sysexitproc:pointer;
  139.     tmpstr:string;
  140.     header:qtheader;
  141.     desc:qtdescr;
  142.     nparam:byte;
  143.     mheader:tmacheader;
  144.     switches:tswitches;
  145.  
  146. procedure Fatalerror;far; { Exit procedure}
  147. begin
  148.  close(fdat);
  149.  close(fres);
  150.  close(fout);
  151.  if ioresult<>0 then;
  152.  if Exitcode<>0 then writeln('Error number ',Exitcode);
  153.  Exitcode:=0;
  154.  Erroraddr:=nil;
  155.  exitproc:=sysexitproc;
  156. end;
  157.  
  158. procedure help;
  159. begin
  160.  Writeln('Makes flattened movie from separate Resource and Data fork'#13#10+
  161.      'Use "qtflat.exe  Data_Fork_File  Resource_Fork_File  Resulting_Flattened_Movie"');
  162.  Writeln(#13#10'Also checks the integrity of flattened movie'#13#10+
  163.      'In this case use "qtflat.exe   Flattened_Movie"');
  164.  Writeln('Use /e switch if resource and data fork were produced by Executor');
  165.  halt;
  166. end;
  167.  
  168. procedure check(movie:string);
  169. var size,dif:longint;tmp:string[20];macbinary:boolean;
  170. begin
  171.  assign(fout,movie);
  172.  reset(fout,1);
  173.  if ioresult<>0 then quit('Can''t open QuickTime Movie '+movie);
  174.  macbinary:=skipmacheader(fout);
  175.  if macbinary then writeln('The movie contains macbinary header');
  176.   blockread(fout,header,sizeof(header));
  177.   seek(fout,filepos(fout)-sizeof(header));
  178.    if header.sign<>HeaderSign then quit('File '+movie+' dosen''t seem to be a Quicktime Movie');
  179.  if ibmDD(header.descroffset)=0 then quit('The Movie '+movie+' doesn''t seem to be flattened');
  180. if macbinary then
  181.  if ask('Macbinary header is better to be removed. Remove it?[Y/N]')='Y' then
  182.   begin
  183.    assign(fdat,movie);
  184.    reset(fdat,1);
  185.    seek(fout,sizeof(tmacheader));
  186.    copyfile(fout,fdat,filesize(fout)-sizeof(tmacheader));
  187.    truncate(fdat);
  188.    close(fdat); macbinary:=false;
  189.   end;
  190.  size:=ibmDD(header.descroffset);
  191.  if macbinary then inc(size,sizeof(tmacheader));
  192.  seek(fout,size);
  193.  blockread(fout,desc,sizeof(desc));
  194.  if desc.sign<>DescrSign then quit('File '+movie+' seems to have an improper "resource fork"');
  195.  size:=ibmDD(header.descroffset)+ibmDD(desc.structsize);
  196.  if macbinary then inc(size,sizeof(tmacheader));
  197.  dif:=filesize(fout)-size;
  198.  if dif=0 then quit('The movie seems to be OK');
  199.  if dif>0 then
  200.         begin
  201.         str(dif,tmp);
  202.         if ask('The Movie '+movie+' contains '+tmp+' extra bytes.'#13#10+
  203.         '(It might be the reason for being unplayable by QTW).Truncate?[Y/N]')='N'
  204.         then halt
  205.         else begin
  206.               seek(fout,size);
  207.               truncate(fout);
  208.              end;
  209.           end;
  210.  if dif<0 then quit('The movie is probably invalid or incomplete');
  211. end;
  212.  
  213. function getfname(var f:file):string;
  214. var s:string;
  215. begin
  216.  move(tfilestruct(f).name,s[1],80);
  217.  s[0]:=char(pos(#0,s)-1);
  218.  getfname:=s;
  219. end;
  220.  
  221. function ScanFormoov(var f:file):boolean;
  222. var size,len,pos,p:longint;
  223.     d:qtdescr;
  224.     found:boolean;
  225. begin
  226.  found:=false;
  227.  size:=filesize(f);
  228.  pos:=filepos(f);
  229.  blockread(f,p,sizeof(p));
  230.  inc(pos,ibmDD(p));
  231.  seek(f,pos);
  232.  while pos<size do
  233.  begin
  234.   blockread(f,len,sizeof(len));
  235.   blockread(f,d,sizeof(d));
  236.   inc(pos,4);
  237.   if d.sign=DescrSign then begin seek(f,pos); found:=true; break; end;
  238.   if ibmDD(len)=0 then break;
  239.   inc(pos,ibmDD(len));
  240.   seek(f,pos);
  241.  end;
  242.  ScanFormoov:=found;
  243. end;
  244.  
  245. procedure flattenfile(var fdat,fres,fout:file);
  246. var len:longint;
  247. begin
  248.  blockread(fdat,header,sizeof(header));
  249.   if header.sign<>HeaderSign then quit('Data Fork file '+getfname(fdat)+'  dosen''t seem to be a Quicktime Movie');
  250.    if ibmDD(header.descroffset)<>0 then if ask('The Movie seems to be flattened already.Proceed?[Y/N]')='N' then halt;
  251.    header.descroffset:=appleDD(filesize(fdat));
  252.    blockwrite(fout,header,sizeof(header));
  253.    copyfile(fdat,fout,ibmDD(header.descroffset)-sizeof(header));
  254.    blockread(fres,desc,sizeof(desc));
  255.    blockwrite(fout,desc,sizeof(desc));
  256.    copyfile(fres,fout,ibmDD(desc.structSize)-sizeof(desc));
  257.    truncate(fout);
  258.    writeln('Now QuickTime for Windows ought to load the file with no problem');
  259.    writeln('Have fun.');
  260. end;
  261.  
  262. procedure flatten(data,resource,movie:string);
  263. begin
  264.    assign(fdat,data);
  265.    assign(fres,resource);
  266.    assign(fout,movie);
  267.    reset(fdat,1); if ioresult<>0 then quit('Can''t open Data Fork file '+data);
  268.    reset(fres,1); if ioresult<>0 then quit('Can''t open Resource Fork file '+resource);
  269.    reset(fout,1); if ioresult=0 then
  270.                   begin
  271.                    if ask('File '+movie+' already exists. Overwrite?[Y/N]')='N' then halt;
  272.                   end
  273.                  else rewrite(fout,1);
  274.    if skipmacheader(fdat) then writeln('Data fork has macbinary header');
  275.    if switches.executor then seek(fres,filepos(fres)+512);
  276.    if skipmacheader(fres) then writeln('Resorce fork has macbinary header');
  277.    if not ScanFormoov(fres) then quit('Resource Fork '+resource+' file doesn''t seem to be a proper QuickTime resource fork.');
  278.    flattenfile(fdat,fres,fout);
  279. end;
  280. procedure GetSwitches(var switches:tswitches);
  281. var param:^string;p:byte;
  282. begin
  283.  fillchar(switches,sizeof(switches),0);
  284.  param:=ptr(prefixseg,128);
  285.  for p:=1 to length(param^) do param^[p]:=upcase(param^[p]);
  286.  p:=pos('/E',param^);
  287.  if p<>0 then begin  delete(param^,p,2); switches.executor:=true; end;
  288. end;
  289.  
  290. BEGIN
  291.    sysexitproc:=exitproc;
  292.    exitproc:=@fatalerror;
  293.    Writeln('QuickTime Movie flattener for DOS by Alex Novikov (Chip) V1.1 1994. Use free. '#13#10);
  294.       getswitches(switches);
  295.       nparam:=paramcount;
  296.  case nparam of
  297.   1:check(paramstr(1));
  298.   3:flatten(paramstr(1),paramstr(2),paramstr(3));
  299.   else help;
  300.  end;
  301. END.